home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / WINDWS_U / RIBBON / RIBBON3.PAS
Pascal/Delphi Source File  |  1992-08-05  |  6KB  |  179 lines
  1. {************************************************}
  2. {                                                }
  3. {   Ribbon.pas                                   }
  4. {   Turbo Pascal for Windows demo program        }
  5. {   by Danny Thorpe                              }
  6. {                                                }
  7. {   This program shows how to set up a non-MDI   }
  8. {   child window in a MDI window.  Why would     }
  9. {   you want to do this?  To implement status    }
  10. {   lines and "ribbon" windows which you want    }
  11. {   to be in the main window, but you don't want }
  12. {   to be cascaded and tiled with the MDI child  }
  13. {   windows, and you don't want to be overlapped }
  14. {   by the MDI child windows.                    }
  15. {                                                }
  16. {   In addition, I have modified it to show how  }
  17. {   to create a button ribbon bar and handle it's}
  18. {   messages. - Rick Sands CIS 70274,103         }
  19. {                                                }
  20. {   Modified Aug. 5, 92                          }
  21. {   Using Windows 3.1's RedrawWindow Function    }
  22. {   I modified this example to eliminate screen  }
  23. {   Blinking when the window is resized. -       }
  24. {   Bob Kitchenham CIS 70334,1112                }
  25. {************************************************}
  26.  
  27. program MDI;
  28.  
  29. {$R MDIAPP.RES}    { This res file is in \tpw\owldemos }
  30.  
  31. uses WObjects, WinTypes, WinProcs, win31;
  32.  
  33. const
  34.   ID_Test = 1000;
  35.   CM_Test = 1010;
  36.  
  37. type
  38.  
  39.   PRibbonWindow = ^TRibbonWindow;
  40.   TRibbonWindow = object(TWindow)
  41.     LastWnd : hWnd;
  42.     btnTest : pButton;
  43.     constructor Init(AParent: PWindowsObject);
  44.     procedure   GetWindowClass(var AWndClass: TWndClass); virtual;
  45.     function    GetClassName : pchar; virtual;
  46.     procedure   idTest(var Msg:tMessage); virtual id_First + id_Test;
  47.     procedure   wmSetFocus(var Msg:tMessage); virtual wm_First + wm_SetFocus;
  48.   end;
  49.  
  50.   pChildWin = ^tChildWin;
  51.   tChildWin = object(tWindow)
  52.     procedure CMTest(var Msg:tMessage); virtual cm_First+cm_Test;
  53.   end;
  54.  
  55.   PMyMDIWindow = ^TMyMDIWindow;
  56.   TMyMDIWindow = object(TMDIWindow)
  57.     RibbonWindow : PRibbonWindow;
  58.     constructor Init(ATitle: PChar;  AMenu: HMenu);
  59.     function    CreateChild: PWindowsObject; virtual;
  60.     procedure   WMSize(var Msg: TMessage);  virtual wm_First + wm_Size;
  61.   end;
  62.  
  63.  
  64.   { Define a TApplication descendant }
  65.   TMDIApp = object(TApplication)
  66.     procedure InitMainWindow; virtual;
  67.   end;
  68.  
  69.  
  70. {************************************************************************}
  71.  
  72. constructor TRibbonWindow.Init(AParent: PWindowsObject);
  73. begin
  74.   TWindow.Init(AParent, '');              { create the window normally }
  75.   SetFlags(wb_MDIChild, False);           { turn off the MDI flag that TWindow set }
  76.   Attr.Style := ws_Border or ws_Child or ws_Visible;
  77.   btnTest  := new(pButton, Init(@Self, id_Test, '&Test', 0,  0, 70, 28, FALSE));
  78. end;
  79.  
  80. { -------------------------------------------------------------------------- }
  81. procedure tRibbonWindow.GetWindowClass(var AWndClass: TWndClass);
  82.   begin
  83.      tWindow.GetWindowClass(AWndClass);
  84.      AWndClass.hbrBackground := Gray_Brush
  85.   end;
  86.  
  87. { -------------------------------------------------------------------------- }
  88. function tRibbonWindow.GetClassName : pchar;
  89.   begin
  90.      GetClassName := 'Ribbon';
  91.   end;
  92.  
  93. { -------------------------------------------------------------------------- }
  94. procedure tRibbonWindow.wmSetFocus(var Msg:tMessage);
  95.   begin
  96.      messagebeep(0);
  97.   end;
  98.  
  99. { -------------------------------------------------------------------------- }
  100. procedure tRibbonWindow.idTest(var Msg:tMessage);
  101.   begin
  102.      { You must set the focus to the main window before sending your
  103.        command!!! }
  104.      SetFocus(Application^.MainWindow^.hWIndow);
  105.      SendMessage(Application^.MainWindow^.hWindow, wm_Command, cm_Test, 0)
  106.   end;
  107.  
  108.  
  109. {************************************************************************}
  110. procedure tChildWin.CMTest(var Msg:tMessage);
  111.   begin
  112.      MessageBox(hWindow, 'Message Sent Successfully!', 'Success', mb_OK);
  113.   end;
  114.  
  115. {************************************************************************}
  116. constructor TMyMDIWindow.Init(ATitle: PChar;  AMenu: HMenu);
  117. begin
  118.   TMDIWindow.Init(ATitle, AMenu);
  119.   RibbonWindow := New(PRibbonWindow, Init(@Self));
  120. end;
  121.  
  122.  
  123. procedure TMyMDIWindow.WMSize(var Msg: TMessage);
  124. var
  125.     rcUpdate : TRect;
  126. begin
  127.   getUpdateRect(Hwindow,rcUpdate,False); {Save Update Rectangle for later}
  128.  
  129.   sendmessage(HWindow,wm_setredraw,0,0); {Disable Redrawing of window}
  130.       
  131.   TMDIWindow.WMSize(Msg);
  132.  
  133.  
  134.   { Always check for nil window pointers and invalid HWindow handles.  Windows can
  135.     send your main window WMSize messages while the child windows are being destroyed,
  136.     which can produce some hard to track down UAEs.  }
  137.  
  138.     if (ClientWnd <> nil) and (ClientWnd^.HWindow <> 0) then
  139.       MoveWindow(ClientWnd^.HWindow, 0, 30, Msg.LParamLo, Msg.LParamHi - 30, True);
  140.  
  141.     if (RibbonWindow <> nil) and (RibbonWindow^.HWindow <> 0) then
  142.         MoveWindow(RibbonWindow^.HWindow, -1, -1, Msg.LParamLo + 2, 30, True);
  143.  
  144.   sendmessage(HWindow,wm_setredraw,1,0); {enable Redrawing of window}
  145.  
  146.   RedrawWindow(Hwindow,@rcUpdate,0,
  147.      RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN); {Redraw Update Rect}
  148.  
  149.     { The -1 and +2 are to hide the left and right borders of this ribbon window.
  150.       It looks funny with no border at all, but it looks funny with extra thick borders
  151.       on the left and right.  This sets a happy medium.  }
  152. end;
  153.  
  154.  
  155. function TMyMDIWindow.CreateChild: PWindowsObject;
  156.   begin
  157.      CreateChild := Application^.MakeWindow(new(pChildWin, Init(@Self, 'A Test Child')));
  158.   end;
  159.  
  160. {*************************************************************************}
  161.  
  162. { Construct the THelloApp's MainWindow object, loading its menu }
  163. procedure TMDIApp.InitMainWindow;
  164. begin
  165.   MainWindow := New(PMyMDIWindow, Init('MDI Conformist',
  166.     LoadMenu(HInstance, 'MDIMenu')));
  167. end;
  168.  
  169. { Declare a variable of type TMDIApp}
  170. var
  171.   MDIApp: TMDIApp;
  172.  
  173. { Run the MDIApp }
  174. begin
  175.   MDIApp.Init('MDIApp');
  176.   MDIApp.Run;
  177.   MDIApp.Done;
  178. end.
  179.